home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 051-075 / scopedisk72 / tictac / tictactoe.mod < prev    next >
Text File  |  1995-03-19  |  13KB  |  476 lines
  1. MODULE TicTacToe;
  2.  
  3. (*
  4. -----------------------------------------------------------------------------
  5.   Author:       Robert Salesas
  6.   Program:      TicTacToe  V1.0
  7.   Created:      27 April 1989
  8.   Modified:     ---
  9.   Comments:     Link with RT.lnk
  10. -----------------------------------------------------------------------------
  11. *)
  12.  
  13. FROM SYSTEM             IMPORT  ADR, ADDRESS;
  14. FROM ChipData           IMPORT  dataPtr;
  15. FROM Intuition          IMPORT  WindowFlags, WindowFlagSet, WindowPtr, IDCMPFlags, IDCMPFlagSet, SmartRefresh,
  16.                                 CloseWindow, ImagePtr, DrawImage, Gadget, GadgetPtr, BoolGadget,
  17.                                 GadgHNone, ActivationFlags, ActivationFlagSet, IntuiMessage,
  18.                                 MenuPtr, HighNone, HighComp, ItemFlags, ItemFlagSet,
  19.                                 SetMenuStrip, ClearMenuStrip, SetWindowTitles, ITEMNUM, SUBNUM;
  20. FROM EasyBeeper         IMPORT  Beep;
  21. FROM EasyWindows        IMPORT  CreateWindow;
  22. FROM EasyMenus          IMPORT  StartStrip, DisposeStrip, currentStrip, stripFailed,
  23.                                 nextSubFlags, nextSubLeftEdge, nextSubWidth, AddMenu, AddItem, AddSub;
  24. FROM EasyIDCMP          IMPORT  ProcTable, ProcessEvents;
  25. FROM RandomNumbers      IMPORT  Random;
  26. FROM DOSProcess         IMPORT  Delay;
  27. (*FROM InOut              IMPORT  WriteCard, WriteString, WriteLn;*)
  28.  
  29. TYPE
  30.   Coord = RECORD
  31.     X, Y, Mx, My  : CARDINAL;
  32.   END;
  33.  
  34.   MatrixFlags = (N, X, O, D);
  35.   MatrixRec = RECORD
  36.     XY  :  MatrixFlags;
  37.     Gad :  CARDINAL;
  38.   END;
  39.  
  40.   ModeFlags   = (PP, PC, CC);
  41.  
  42.  
  43. VAR
  44.   Wp        :   WindowPtr;
  45.   GList     :   ARRAY [0..9] OF Gadget;
  46.   GadCoor   :   ARRAY [0..8] OF Coord;
  47.   Strip     :   MenuPtr;
  48.   Matrix    :   ARRAY [0..2], [0..2] OF MatrixRec;
  49.   Turn      :   MatrixFlags;
  50.   GEnd      :   BOOLEAN;
  51.   Mode      :   ModeFlags;
  52.   BoardPtr  :   ImagePtr;
  53.   XOPtr     :   ARRAY [0..1] OF ImagePtr;
  54.   Table     :   ProcTable;
  55.   Result    :   INTEGER;
  56.  
  57.  
  58.  
  59. PROCEDURE ClearMatrix();
  60. VAR
  61.   L1, L2    :   CARDINAL;
  62.   GadID     :   CARDINAL;
  63.  
  64. BEGIN
  65.   GadID := 0;
  66.   FOR L1:=0 TO 2 DO
  67.     FOR L2:=0 TO 2 DO
  68.       Matrix[L1,L2].XY := N;  Matrix[L1,L2].Gad := GadID;
  69.       INC(GadID);
  70.     END;
  71.   END;
  72.   DrawImage(Wp^.RPort,BoardPtr,2,10);
  73. END ClearMatrix;
  74.  
  75.  
  76. PROCEDURE CheckWin() : MatrixFlags;
  77. VAR
  78.   L1, L2    :   CARDINAL;
  79.  
  80. BEGIN
  81.   FOR L1:=0 TO 2 DO               (* Check X *)
  82.     IF (Matrix[L1,0].XY # N) AND (Matrix[L1,0].XY = Matrix[L1,1].XY) AND (Matrix[L1,1].XY = Matrix[L1,2].XY) THEN
  83.       RETURN Matrix[L1,0].XY;
  84.     END;
  85.   END;
  86.   FOR L1:=0 TO 2 DO               (* Check Y *)
  87.     IF  (Matrix[0,L1].XY # N) AND (Matrix[0,L1].XY = Matrix[1,L1].XY) AND (Matrix[1,L1].XY = Matrix[2,L1].XY) THEN
  88.       RETURN Matrix[0,L1].XY;
  89.     END;
  90.   END;
  91.                                   (* Check Diagonal *)
  92.   IF (Matrix[0,0].XY = Matrix[1,1].XY) AND (Matrix[1,1].XY = Matrix[2,2].XY) THEN
  93.     RETURN Matrix[0,0].XY;
  94.   END;
  95.   IF (Matrix[0,2].XY = Matrix[1,1].XY) AND (Matrix[1,1].XY = Matrix[2,0].XY) THEN
  96.     RETURN Matrix[0,2].XY;
  97.   END;
  98.                                   (* Check Empty Space *)
  99.   FOR L1:=0 TO 2 DO
  100.     FOR L2:=0 TO 2 DO
  101.       IF (Matrix[L1,L2].XY = N) THEN
  102.         RETURN N;
  103.       END;
  104.     END;
  105.   END;
  106.   RETURN D;
  107. END CheckWin;
  108.  
  109.  
  110. PROCEDURE CheckNow();
  111. BEGIN
  112.   CASE CheckWin() OF
  113.     |N  :  IF (Turn = X) THEN
  114.              SetWindowTitles(Wp,ADR("It's X's Turn!"),NIL);
  115.            ELSE
  116.              SetWindowTitles(Wp,ADR("It's O's Turn!"),NIL);
  117.            END;
  118.     |X  :  GEnd := TRUE;  SetWindowTitles(Wp,ADR('"X" Wins!!!'),NIL);  Beep;
  119.     |O  :  GEnd := TRUE;  SetWindowTitles(Wp,ADR('"O" Wins!!!'),NIL);  Beep;
  120.     |D  :  GEnd := TRUE;  SetWindowTitles(Wp,ADR("It's A Draw!!!"),NIL);  Beep;
  121.   END;
  122. END CheckNow;
  123.  
  124.  
  125. PROCEDURE Computer(Peg : MatrixFlags);
  126. VAR
  127.   Mx, My,
  128.   L1, L2,
  129.   Gad     :   CARDINAL;
  130.  
  131.   PROCEDURE FreeSpace() : BOOLEAN;
  132.   BEGIN
  133.     FOR L1:=0 TO 2 DO
  134.       FOR L2:=0 TO 2 DO
  135.         IF (Matrix[L1,L2].XY = N) THEN
  136.           RETURN TRUE;
  137.         END;
  138.       END;
  139.     END;
  140.     RETURN FALSE;
  141.   END FreeSpace;
  142.  
  143.   PROCEDURE TwoInARow(Flag : MatrixFlags) : BOOLEAN;
  144.   VAR
  145.     L1      :   CARDINAL;
  146.  
  147.   BEGIN
  148.     FOR L1:=0 TO 2 DO             (* Check X *)
  149.       IF (Matrix[0,L1].XY = Flag) AND (Matrix[2,L1].XY = N) AND
  150.                          (Matrix[0,L1].XY = Matrix[1,L1].XY) THEN
  151.         Mx := 2;  My := L1;
  152.         RETURN TRUE;
  153.       END;
  154.       IF (Matrix[2,L1].XY = Flag) AND (Matrix[0,L1].XY = N) AND
  155.                          (Matrix[1,L1].XY = Matrix[2,L1].XY) THEN
  156.         Mx := 0;  My := L1;
  157.         RETURN TRUE;
  158.       END;
  159.       IF (Matrix[0,L1].XY = Flag) AND (Matrix[1,L1].XY = N) AND
  160.                          (Matrix[0,L1].XY = Matrix[2,L1].XY) THEN
  161.         Mx := 1;  My := L1;
  162.         RETURN TRUE;
  163.       END;
  164.     END;
  165.     FOR L1:=0 TO 2 DO             (* Check Y *)
  166.       IF (Matrix[L1,0].XY = Flag) AND (Matrix[L1,2].XY = N) AND
  167.                          (Matrix[L1,0].XY = Matrix[L1,1].XY) THEN
  168.         Mx := L1;  My := 2;
  169.         RETURN TRUE;
  170.       END;
  171.       IF (Matrix[L1,2].XY = Flag) AND (Matrix[L1,0].XY = N) AND
  172.                          (Matrix[L1,1].XY = Matrix[L1,2].XY) THEN
  173.         Mx := L1;  My := 0;
  174.         RETURN TRUE;
  175.       END;
  176.       IF (Matrix[L1,0].XY = Flag) AND (Matrix[L1,1].XY = N) AND
  177.                          (Matrix[L1,0].XY = Matrix[L1,2].XY) THEN
  178.         Mx := L1;  My := 1;
  179.         RETURN TRUE;
  180.       END;
  181.     END;
  182.                                   (* Check \ *)
  183.     IF (Matrix[0,0].XY = Flag) AND (Matrix[2,2].XY = N) AND
  184.                        (Matrix[0,0].XY = Matrix[1,1].XY) THEN
  185.       Mx := 2;  My := 2;
  186.       RETURN TRUE;
  187.     END;
  188.     IF (Matrix[2,2].XY = Flag) AND (Matrix[0,0].XY = N) AND
  189.                        (Matrix[1,1].XY = Matrix[2,2].XY) THEN
  190.       Mx := 0;  My := 0;
  191.       RETURN TRUE;
  192.     END;
  193.     IF (Matrix[0,0].XY = Flag) AND (Matrix[1,1].XY = N) AND
  194.                        (Matrix[0,0].XY = Matrix[2,2].XY) THEN
  195.       Mx := 1;  My := 1;
  196.       RETURN TRUE;
  197.     END;
  198.                                   (* Check / *)
  199.     IF (Matrix[0,2].XY = Flag) AND (Matrix[2,0].XY = N) AND
  200.                        (Matrix[0,2].XY = Matrix[1,1].XY) THEN
  201.       Mx := 2;  My := 0;
  202.       RETURN TRUE;
  203.     END;
  204.     IF (Matrix[2,0].XY = Flag) AND (Matrix[0,2].XY = N) AND
  205.                        (Matrix[1,1].XY = Matrix[2,0].XY) THEN
  206.       Mx := 0;  My := 2;
  207.       RETURN TRUE;
  208.     END;
  209.     IF (Matrix[0,2].XY = Flag) AND (Matrix[1,1].XY = N) AND
  210.                        (Matrix[0,2].XY = Matrix[2,0].XY) THEN
  211.       Mx := 1;  My := 1;
  212.       RETURN TRUE;
  213.     END;
  214.     RETURN FALSE;
  215.   END TwoInARow;
  216.   
  217.   PROCEDURE RandomSpot();
  218.   BEGIN
  219.     LOOP;
  220.       Mx := Random(3);  My := Random(3);
  221.       IF (Matrix[Mx,My].XY = N) THEN
  222.         EXIT;
  223.       END;
  224.     END; 
  225.   END RandomSpot;
  226.  
  227.   PROCEDURE PlacePeg();
  228.   BEGIN
  229.     Matrix[Mx,My].XY := Peg;
  230.     Gad := Matrix[Mx,My].Gad;
  231.     DrawImage(Wp^.RPort,XOPtr[ORD(Peg) - 1],GadCoor[Gad].X + 4,GadCoor[Gad].Y + 1);
  232.   END PlacePeg;
  233.  
  234.  
  235.  
  236. BEGIN
  237.   Mx := 0; My := 0;
  238.   IF FreeSpace() THEN
  239.     IF (Matrix[1,1].XY = N) THEN
  240.       Mx := 1;  My := 1;
  241.     ELSIF NOT TwoInARow(Peg) THEN
  242.       CASE Peg OF
  243.         |O  :  IF NOT TwoInARow(X) THEN RandomSpot;  END;
  244.         |X  :  IF NOT TwoInARow(O) THEN RandomSpot;  END;
  245.       END;
  246.     END;
  247.     PlacePeg;
  248.   END;
  249. END Computer;
  250.  
  251.  
  252. PROCEDURE HandleCloseWindow(VAR Message : IntuiMessage) : INTEGER;
  253. BEGIN
  254.   RETURN -1;
  255. END HandleCloseWindow;
  256.  
  257.  
  258. PROCEDURE HandleMenus(VAR Message : IntuiMessage;  MenuNum : CARDINAL) : INTEGER;
  259. VAR
  260.   Item, Sub :   CARDINAL;
  261.   L1, L2    :   CARDINAL;
  262.  
  263. BEGIN
  264.   Item := ITEMNUM(MenuNum) + 1;  Sub := SUBNUM(MenuNum) + 1;
  265.   IF (Item = 3) THEN
  266.     RETURN -1;
  267.   ELSIF (Item = 1) THEN
  268.     ClearMatrix;  Turn := X;  GEnd := FALSE;
  269.     CASE Sub OF
  270.       |1  :  Mode := PP;  SetWindowTitles(Wp,ADR("Player/Player"),NIL);
  271.       |2  :  Mode := PC;  SetWindowTitles(Wp,ADR("Player/Computer"),NIL);
  272.       |3  :  Mode := CC;  SetWindowTitles(Wp,ADR("Computer/Computer"),NIL);
  273.              RETURN 1
  274.     END;
  275.   END;
  276.   RETURN NIL;
  277. END HandleMenus;
  278.  
  279.  
  280. PROCEDURE HandleGadgets(VAR Message : IntuiMessage;  Gadget : GadgetPtr) : INTEGER;
  281. VAR
  282.   Gad       :   CARDINAL;
  283.   Mx, My    :   CARDINAL;
  284.  
  285.   PROCEDURE Player();
  286.   BEGIN
  287.     IF (Turn = O) THEN
  288.       Matrix[Mx,My].XY := O;
  289.       DrawImage(Wp^.RPort,XOPtr[1],GadCoor[Gad].X + 4,GadCoor[Gad].Y + 1);
  290.     ELSE
  291.       Matrix[Mx,My].XY := X;
  292.       DrawImage(Wp^.RPort,XOPtr[0],GadCoor[Gad].X + 4,GadCoor[Gad].Y + 1);
  293.     END;
  294.   END Player;
  295.  
  296.  
  297. BEGIN
  298.   Gad := Gadget^.GadgetID;
  299.   IF (Gad = 9) THEN
  300.     ClearMatrix;  Turn := X;  GEnd := FALSE;
  301.     CASE Mode OF
  302.       |PP  :  SetWindowTitles(Wp,ADR("Player/Player"),NIL);
  303.       |PC  :  SetWindowTitles(Wp,ADR("Player/Computer"),NIL);
  304.       |CC  :  SetWindowTitles(Wp,ADR("Computer/Computer"),NIL);
  305.               RETURN 1
  306.     END;
  307.     RETURN NIL;
  308.   ELSIF GEnd OR (Mode = CC) THEN
  309.     RETURN NIL;
  310.   END;
  311.   Mx := GadCoor[Gad].Mx;  My := GadCoor[Gad].My;
  312.   IF (Matrix[Mx,My].XY # N) THEN
  313.     Beep;
  314.   ELSE
  315.     CASE Mode OF
  316.       |PP : Player;
  317.             IF (Turn = X) THEN
  318.               Turn := O;
  319.             ELSE
  320.               Turn := X;
  321.             END;
  322.             CheckNow
  323.       |PC : Player;  CheckNow;
  324.             IF NOT GEnd THEN
  325.               Computer(O);  CheckNow;
  326.             END;
  327.     END;
  328.   END;
  329.   RETURN NIL;
  330. END HandleGadgets;
  331.  
  332.  
  333. PROCEDURE PlayCC();
  334. BEGIN
  335.   WHILE NOT GEnd DO
  336.     Computer(X);  CheckNow;
  337.     IF NOT GEnd THEN
  338.       Computer(O);  CheckNow;
  339.     END;
  340.   END;
  341. END PlayCC;
  342.  
  343.  
  344. PROCEDURE Init(VAR Wp : WindowPtr;  VAR Strip : MenuPtr;
  345.                VAR GList : ARRAY OF Gadget;  GadCoor : ARRAY OF Coord) : BOOLEAN;
  346.  
  347.   PROCEDURE SetGadgets();
  348.   VAR
  349.     Gad     :   CARDINAL;
  350.  
  351.   BEGIN
  352.     FOR Gad := 0 TO 8 DO
  353.       WITH GList[Gad] DO
  354.         NextGadget   :=  ADR(GList[Gad + 1]);
  355.         LeftEdge     :=  GadCoor[Gad].X;
  356.         TopEdge      :=  GadCoor[Gad].Y;
  357.         Width        :=  47;
  358.         Height       :=  23;
  359.         Flags        :=  GadgHNone;
  360.         Activation   :=  ActivationFlagSet{RelVerify};
  361.         GadgetType   :=  BoolGadget;
  362.         GadgetID     :=  Gad;
  363.       END;
  364.     END;
  365.     WITH GList[9] DO
  366.       NextGadget   :=  NIL;
  367.       LeftEdge     :=  50;
  368.       TopEdge      :=  14;
  369.       Width        :=  126;
  370.       Height       :=  19;
  371.       Flags        :=  GadgHNone;
  372.       Activation   :=  ActivationFlagSet{RelVerify};
  373.       GadgetType   :=  BoolGadget;
  374.       GadgetID     :=  9;
  375.     END;
  376.   END SetGadgets;
  377.  
  378.   PROCEDURE OpenWindow();
  379.   BEGIN
  380.     Wp := CreateWindow(202,39,236,120,"Player/Player",
  381.                        IDCMPFlagSet{GadgetUp, CloseWindowFlag, MenuPick},
  382.                        WindowFlagSet{WindowDepth, WindowDrag, WindowClose,
  383.                                      NoCareRefresh, Activate} + SmartRefresh,
  384.                                      NIL,ADR(GList));
  385.   END OpenWindow;
  386.  
  387.   PROCEDURE SetMenus();
  388.   BEGIN
  389.     StartStrip;
  390.     AddMenu("Project    ",100);
  391.       nextSubLeftEdge := 70;  nextSubWidth := 232;
  392.       AddItem("New Game",0C);
  393.         AddSub("Player Vs. Player       ","1");
  394.         AddSub("Player Vs. Computer     ","2");
  395.         AddSub("Computer Vs. Computer   ","3");
  396.       AddItem("About...",0C);
  397.         nextSubWidth := 100;
  398.         nextSubFlags := ItemFlagSet{ItemText, ItemEnabled} + HighNone;
  399.         AddSub("     Tic Tac Toe  V1.00",0C);
  400.         AddSub("      © Copyright 1989",0C);
  401.         AddSub("     By  Robert Salesas",0C);
  402.         AddSub(0C,0C);
  403.         AddSub("  Developed using M2Sprint  ",0C);
  404.         AddSub("       for the Amiga.",0C);
  405.         AddSub("  M2S Inc., Dallas, Texas.",0C);
  406.       AddItem("Quit","Q");
  407.     IF NOT stripFailed THEN
  408.       Strip := currentStrip;
  409.       SetMenuStrip(Wp,Strip);
  410.     END;
  411.   END SetMenus;
  412.   
  413.  
  414. BEGIN
  415.   SetGadgets;
  416.   OpenWindow;
  417.   IF (Wp # NIL) THEN
  418.     SetMenus;
  419.     IF (Strip # NIL) THEN
  420.       DrawImage(Wp^.RPort,BoardPtr,2,10);
  421.       RETURN TRUE;
  422.     END;
  423.   END;
  424.   RETURN FALSE;
  425. END Init;
  426.  
  427.  
  428. PROCEDURE InitVars();
  429. BEGIN
  430.   BoardPtr := ADR(dataPtr^[0]);
  431.   XOPtr[1] := ADR(dataPtr^[1]);  XOPtr[0] := ADR(dataPtr^[2]);
  432.   Turn := X;
  433. END InitVars;
  434.  
  435.  
  436. PROCEDURE InitProcTable(VAR Table : ProcTable);
  437. BEGIN
  438.   WITH Table DO
  439.     WaitForEvent := TRUE;
  440.     CloseWindow  := HandleCloseWindow;
  441.     MenuPick     := HandleMenus;
  442.     GadgetUp     := HandleGadgets;
  443.   END;
  444. END InitProcTable;
  445.  
  446.  
  447. PROCEDURE InitGadCoor(VAR GadCoor : ARRAY OF Coord);
  448. BEGIN
  449.   GadCoor[0].X := 39;   GadCoor[0].Y := 35;  GadCoor[0].Mx := 0;  GadCoor[0].My := 0;
  450.   GadCoor[1].X := 91;   GadCoor[1].Y := 35;  GadCoor[1].Mx := 0;  GadCoor[1].My := 1;
  451.   GadCoor[2].X := 139;  GadCoor[2].Y := 35;  GadCoor[2].Mx := 0;  GadCoor[2].My := 2;
  452.   GadCoor[3].X := 39;   GadCoor[3].Y := 61;  GadCoor[3].Mx := 1;  GadCoor[3].My := 0;
  453.   GadCoor[4].X := 91;   GadCoor[4].Y := 61;  GadCoor[4].Mx := 1;  GadCoor[4].My := 1;
  454.   GadCoor[5].X := 139;  GadCoor[5].Y := 61;  GadCoor[5].Mx := 1;  GadCoor[5].My := 2;
  455.   GadCoor[6].X := 39;   GadCoor[6].Y := 85;  GadCoor[6].Mx := 2;  GadCoor[6].My := 0;
  456.   GadCoor[7].X := 91;   GadCoor[7].Y := 85;  GadCoor[7].Mx := 2;  GadCoor[7].My := 1;
  457.   GadCoor[8].X := 139;  GadCoor[8].Y := 85;  GadCoor[8].Mx := 2;  GadCoor[8].My := 2;
  458. END InitGadCoor;
  459.  
  460.  
  461.  
  462. BEGIN
  463.   InitGadCoor(GadCoor);
  464.   InitProcTable(Table);
  465.   InitVars;
  466.   IF Init(Wp,Strip,GList,GadCoor) THEN
  467.     REPEAT
  468.       Result := ProcessEvents(Wp,Table);
  469.       IF (Result = 1) THEN
  470.         PlayCC;
  471.       END;
  472.     UNTIL Result = -1;
  473.     ClearMenuStrip(Wp);  DisposeStrip(Strip);
  474.     CloseWindow(Wp);
  475.   END;
  476. END TicTacToe.